perm filename EDSUB.F4[P11,LCS] blob sn#594229 filedate 1981-06-11 generic text, type T, neo UTF8
C************ READX, DASHES, CPYALL, CMDIN  **************

	SUBROUTINE READX
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /ALF/INP(72)/SCM/V(78)
	EQUIVALENCE (V(2),V2)
C****320	REREAD 2430,J,R2,RJQ
C  ↑↑↑ 1/78
	DO 2 K=2,72
	IF(INP(K).NE.'<')GO TO 2
	DO 3 J=K,72
3	INP(J)=' '
	GO TO 4
2	CONTINUE
C CATCH '<' -- WHICH = COMMENT FOR REST OF LINE
4	CALL RREAD(INP,V)
	JA=V(1)
	R2=V2
	DO 1 K=1,20
1	RJQ(K)=V(K+2)
	END

	SUBROUTINE DASHES(IX,R2,RD)
CC	SUBROUTINE DASHES(IX,R2,R3,R4,R5,R6)
	DIMENSION RD(1)
C R3=RD(1) R4=RD(2) . . . R7=RD(5)  R8=RD(6) . . .
      COMMON /XRN/RN(3000)/PTR/KWDS(350)/DL/K22 /STF/RSTFAC(0/7),RSTJ2
	DATA RDX/2.3/,RDZ/0.5/,BSIZE/3.17/
C FIND CLOSEST WORD TO LFT AND RIGHT OF R3    BSIZE=BASIC SIZE OF 1 LETTER
	IF(RD(8).EQ.0)RETURN
C P10 MUST NOT!! BE ZERO.
	B=9999.0
	A=-B
	LFT=0
	JRT=0
	DO 1 K=1,IX
C GETS CODE NUM. J=PTR TO THAT ITEM.
	J=KWDS(K)
5	IF(RN(J+1).NE.16)GO TO 1
C FOUND WORD
	IF(RN(J+2).NE.R2)GO TO 1
C NOW ON THIS STAFF
	IF(ABS(RN(J+4)-RD(2)).GT.4.)GO TO 1
C  P4 OF DASH MUST BE WITHIN +4, -4 VERTICAL STEPS OF WORD ON EITHER SIDE.
7	RR3=RN(J+3)
	IF(RR3.GT.RD(1))GO TO 3
	IF(RR3.LE.A)GO TO 1
	A=RR3
	LFT=J
C A WILL BE POS. OF FRONT OF LEFT GROUP.  LFT IS PNTR.
	GO TO 1
3	IF(RR3.GE.B)GO TO 1
	B=RR3
	JRT=J
1	CONTINUE
C WON'T WORK WITH OVERLAPPING WORDS!!!!

	J=LFT
	IF(LFT.NE.0)GO TO 2
	IF(JRT.EQ.0)RETURN
	J=JRT
2	SZ=RN(J+5)
	R5=SZ*RSTJ2
C R=REAL SIZE FACTOR FOR SPACE     RN(LFT+9) IS WIDTH OF GROUP TO LEFT.
	RP=R5*RN(J+9)+A
	IF(RP.LT.0)RP=3.0
C RP=RIGHT SIDE OF LEFT CHAR. STRING.
	R3=RP
	IF(B.GT.201)B=201.
	R6=B-R5*BSIZE
CC	RR6=R6
	IF(R3.LT.0)R3=4.
CX	IF(R6.GT.201)R6=201.
C 3.17 IS BASIC WIDTH OF MOST LETTERS
	IF(RD(5).EQ.0)GO TO 4
C SKIP IF R7=0 (NO SHORT DASHES)
	A=B-RP-BSIZE*R5
C DIST. FROM END OF LFT WD TO START OF RT WD. (LESS 2 CHAR SPACES)
8	B=IFIX(A/(25.*R5))+1.
C  B=NUMB OF DASHES
9	RR3=2.5*SZ
C RR3 IS DASH WIDTH
	A=(A-B*2.5*R5)/(B+1.)
C A=SPACE BETWEEN DASHES  (P9)  IF SPACE IS TOO SMALL MAKE LRG DASH.
CCC	IF(A.LT.RDZ)GO TO 11
	R3=RP+A
10	R6=R6-RDZ
CC10	R6=R3+(RR3+A)*B-RR3-RDZ
	RD(6)=RR3
	RD(7)=A/RSTJ2
C P9(SPACE BETWEEN DASHES) REAL SIZE IS P9*RSTJ2
CCC	GO TO 4
CCC11	RD(5)=0
4	RD(2)=RN(J+4)+1.0-R5*0.5
C  SET HEIGHT OF DASH   CONSIDERS LETTER SIZE AND STAFF SIZE
	RD(3)=RD(2)
C WAS R5=R4
	RD(1)=R3
	IF(R6-R3.LT.0.2)R6=R3+0.2
	RD(4)=R6
	END

	SUBROUTINE CPYALL
C COPIES ALL OF ONE CODE NUM. FROM ONE STAFF TO ALL OTHER ACTIVE STAVES.
	COMMON  /LIMIT/LIMIT,ITEM,L,I /PTR/KWDS(1) /POSI/S(8),JJ2
	COMMON R2,J,K,N,RJQ(3),R6,RJ(16),NO,JQ(10),NN,LL  /XRN/RN(1) 
	JJ2=ITEM+1
	J=ITEM
C NOW FIND WHICH STAVES CURRENTLY ACTIVE
	DO 1 K=0,7
1	JQ(K)=0
	DO 2 K=1,J
	L=KWDS(K)
2	JQ(IFIX(RN(L+2)))=-1
	JQ(IFIX(R2))=0
C BUT OMIT SOURCE STAFF
	DO 3 K=1,J
	L=KWDS(K)
	IF(RTLINE(L).LT.0)GO TO 3
C ON RIGHT LINE?
	IF(OUTLIM(L,3).LT.0)GO TO 3
C  WITHIN GIVEN LFT AND RT LIMITS?
9	IF(RN(L+1).NE.R6)GO TO 3
C FOUND A SOURCE ITEM (CODE# IN R11).  NOW PUT IT ON ALL OTHER STAVES.
7	NN=RN(L)+3
C NUMBER OF NEW WORDS ADDED TO ARRAY
	DO 8 N=0,7
	IF(JQ(N).EQ.0)GO TO 8
4	CALL LOOP(0,NN,1,I,L,RN)
5	ITEM=ITEM+1
	LL=KWDS(ITEM)
	RN(LL+2)=N
C PUT IN CORRECT STAFF NUM.
6	I=I+NN
C UPDATE XRN ARRAY COUNTER AND POINTER ARRAY.
	KWDS(ITEM+1)=I
8	CONTINUE
3	CONTINUE
CC	JJ2=ITEM+1
	END

	SUBROUTINE CMDIN
C SAVES INPUT LINES WHEN 1ST CHAR. IS :    EACH STRING=23 CHARS.
C OUTPUTS SAVED LINES WHEN 1ST CHAR. IS ;
	COMMON /ALF/INP(72)
	DIMENSION J(72)
	EQUIVALENCE (I1,INP),(I2,INP(2)),(I3,INP(3))
	IF(I1.EQ.';')GO TO 11
C JUMP TO GET BACK COMMAND 1, 2 OR 3 (; ;; ;;;)
   	N=2
	L=1
	LL=1
10	NN=N+22
	DO 2 K=N,NN
	M=INP(K)
	IF(M.EQ.':')GO TO 3
	J(L)=M
2	L=L+1
	IF(K.EQ.NN)GO TO 6
3	DO 5 KK=K,NN
	J(L)=' '
5	L=L+1
4	IF(M.NE.':')GO TO 6
C 3 COMMANDS CAN BE GIVEN ON ONE LINE, EACH STARTS WITH :
C  THE 1ST ONE WILL BE ACTIVATED IMMEDIATELY, OR BY TYPING ;
C THE 2ND AND 3RD ARE ACTIVATED BY TYPING ;; OR ;;;
C NO ERROR TRAP FOR MORE THEN 3 COLONS
	LL=LL+23
	L=LL
	N=K+1
	GO TO 10
6	N=1
9	NN=N+19
	L=0
	DO 7 K=N,NN
	L=L+1
7	INP(L)=J(K)
	DO 8 K=24,72
C CLEAR REST OF INP ARRAY
8	INP(K)=' '
	RETURN
11	N=1
	IF(I2.EQ.';')N=24
	IF(I3.EQ.';')N=47
	GO TO 9
C  GO GET BACK COMMAND 1, 2 OR 3  (; ;; ;;;)
	END